perm filename BROWSE.IL[TIM,LSP]1 blob sn#679559 filedate 1982-09-27 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 BENCHMARK TO CREATE AND BROWSE THROUGH AN AI-LIKE DATA BASE OF UNITS
C00016 ENDMK
CāŠ—;
;;; BENCHMARK TO CREATE AND BROWSE THROUGH AN AI-LIKE DATA BASE OF UNITS

;;; N IS # OF SYMBOLS
;;; M IS MAXIMUM AMOUNT OF STUFF ON THE PLIST
;;; NPATS IS THE NUMBER OF BASIC PATTERNS ON THE UNIT
;;; IPATS IS THE INSTANTIATED COPIES OF THE PATTERNS

(DECLARE (LOCALVARS . T)(GLOBALARS RAND))


(DEFINEQ
  (INIT
   (LAMBDA (N M NPATS IPATS) 
     ((LAMBDA (IPATS) 
	((LAMBDA (G0018) 
	   (PROG (P) 
		 (SETQ P G0018)
	    LOOP (COND ((NULL (CDR P)) (RETURN (RPLACD P IPATS))))
		 ((LAMBDA (G0018) (SETQ P G0018) (GO LOOP)) (CDR P))))
	 IPATS)
	((LAMBDA (G0019 G0020 G0021 G0022) 
	   (PROG (N I NAME A) 
		 (PROGN (SETQ N G0019)
			(SETQ I G0020)
			(SETQ NAME G0021)
			(SETQ A G0022))
	    LOOP (COND ((IEQP N 0) (RETURN A)))
		 (SETQ A (CONS NAME A))
		 ((LAMBDA (G0023) 
		    (PROG (I) 
			  (SETQ I G0023)
		     LOOP (COND ((IEQP I 0) (RETURN NIL)))
			  (PUTPROP NAME (GENSYM) NIL)
			  ((LAMBDA (G0023) (SETQ I G0023) (GO LOOP))
			   (IDIFFERENCE I 1))))
		  I)
		 (PUTPROP
		  NAME
		  (QUOTE PATTERN)
		  ((LAMBDA (G0024 G0025 G0026) 
		     (PROG (I IPATS A) 
			   (PROGN (SETQ I G0024)
				  (SETQ IPATS G0025)
				  (SETQ A G0026))
		      LOOP (COND ((IEQP I 0) (RETURN A)))
			   (SETQ A (CONS (CAR IPATS) A))
			   ((LAMBDA (G0024 G0025) 
			      (PROGN (SETQ I G0024)
				     (SETQ IPATS G0025))
			      (GO LOOP))
			    (IDIFFERENCE I 1)
			    (CDR IPATS))))
		   NPATS
		   IPATS
		   NIL))
		 ((LAMBDA (G0027) 
		    (PROG (J) 
			  (SETQ J G0027)
		     LOOP (COND ((IEQP J 0) (RETURN NIL)))
			  (PUTPROP NAME (GENSYM) NIL)
			  ((LAMBDA (G0027) (SETQ J G0027) (GO LOOP))
			   (IDIFFERENCE J 1))))
		  (IDIFFERENCE M I))
		 ((LAMBDA (G0019 G0020 G0021) 
		    (PROGN (SETQ N G0019) (SETQ I G0020) (SETQ NAME
							       G0021))
		    (GO LOOP))
		  (IDIFFERENCE N 1)
		  (COND ((IEQP I 0) M) (T (IDIFFERENCE I 1)))
		  (GENSYM))))
	 N
	 M
	 (GENSYM)
	 NIL))
      (SUBST NIL NIL IPATS)))))

(DEFINEQ (SEED (LAMBDA NIL (RPAQ RAND 21))))

(DEFINEQ
  (RANDOM (LAMBDA NIL (SETQ RAND (REMAINDER (ITIMES RAND 17) 251)))))

(DEFINEQ
  (RANDOMIZE
   (LAMBDA (L) 
     ((LAMBDA (G0029) 
	(PROG (A) 
	      (SETQ A G0029)
	 LOOP (COND ((NULL L) (RETURN A)))
	      ((LAMBDA (N) 
		 (COND
		  ((IEQP N 0) (SETQ A (CONS (CAR L) A))
			      (SETQ L (CDR L)))
		  (T
		   ((LAMBDA (G0030 G0031) 
		      (PROG (N X) 
			    (PROGN (SETQ N G0030) (SETQ X G0031))
		       LOOP (COND
			     ((IEQP N 1)
			      (RETURN
			       (PROGN (SETQ A (CONS (CADR X) A))
				      (RPLACD X (CDDR X))))))
			    ((LAMBDA (G0030 G0031) 
			       (PROGN (SETQ N G0030) (SETQ X G0031))
			       (GO LOOP))
			     (IDIFFERENCE N 1)
			     (CDR X))))
		    N
		    L))))
	       (REMAINDER (RANDOM) (LENGTH L)))
	      ((LAMBDA NIL (SETQ) (GO LOOP)))))
      NIL))))

(DEFINEQ
  (MATCH
   (LAMBDA (PAT DAT ALIST) 
     (COND
      ((NULL PAT) (NULL DAT))
      ((NULL DAT) NIL)
      ((OR (EQ (CAR PAT) (QUOTE ?)) (EQ (CAR PAT) (CAR DAT)))
       (MATCH (CDR PAT) (CDR DAT) ALIST))
      ((EQ (CAR PAT) (QUOTE *)) (OR (MATCH (CDR PAT) DAT ALIST)
				    (MATCH (CDR PAT) (CDR DAT) ALIST)
				    (MATCH PAT (CDR DAT) ALIST)))
      (T
       (COND
	((ATOM (CAR PAT))
	 (COND
	  ((EQ (NTHCHAR (CAR PAT) 1) (QUOTE ?))
	   ((LAMBDA (VAL) 
	      (COND
	       (VAL (MATCH (CONS (CDR VAL) (CDR PAT)) DAT ALIST))
	       (T (MATCH (CDR PAT)
			 (CDR DAT)
			 (CONS (CONS (CAR PAT) (CAR DAT)) ALIST)))))
	    (ASSOC (CAR PAT) ALIST)))
	  ((EQ (NTHCHAR (CAR PAT) 1) (QUOTE *))
	   ((LAMBDA (VAL) 
	      (COND
	       (VAL (MATCH (APPEND (CDR VAL) (CDR PAT)) DAT ALIST))
	       (T
		((LAMBDA (G0033 G0034 G0035) 
		   (PROG (L E D) 
			 (PROGN (SETQ L G0033)
				(SETQ E G0034)
				(SETQ D G0035))
		    LOOP (COND ((NULL E) (RETURN NIL)))
			 (COND
			  ((MATCH (CDR PAT) D (CONS (CONS (CAR PAT) L)
						    ALIST))
			   (RETURN T)))
			 ((LAMBDA (G0033 G0034 G0035) 
			    (PROGN (SETQ L G0033)
				   (SETQ E G0034)
				   (SETQ D G0035))
			    (GO LOOP))
			  (NCONC L (CONS (CAR D) NIL))
			  (CDR E)
			  (CDR D))))
		 NIL
		 (CONS NIL DAT)
		 DAT))))
	    (ASSOC (CAR PAT) ALIST)))))
	(T (AND (NOT (ATOM (CAR DAT)))
		(MATCH (CAR PAT) (CAR DAT) ALIST)
		(MATCH (CDR PAT) (CDR DAT) ALIST)))))))))

(DEFINEQ
  (INVESTIGATE
   (LAMBDA (UNITS PATS) 
     ((LAMBDA (G0036) 
	(PROG (UNITS) 
	      (SETQ UNITS G0036)
	 LOOP (COND ((NULL UNITS) (RETURN NIL)))
	      ((LAMBDA (G0037) 
		 (PROG (P) 
		       (SETQ P G0037)
		  LOOP (COND ((NULL P) (RETURN NIL)))
		       ((LAMBDA (G0038) 
			  (PROG (PATS) 
				(SETQ PATS G0038)
			   LOOP	(COND ((NULL PATS) (RETURN NIL)))
				(MATCH (CAR PATS) (CAR P) NIL)
				((LAMBDA (G0038) 
				   (SETQ PATS G0038)
				   (GO LOOP))
				 (CDR PATS))))
			PATS)
		       ((LAMBDA (G0037) (SETQ P G0037) (GO LOOP))
			(CDR P))))
	       (GETPROP (CAR UNITS) (QUOTE PATTERN)))
	      ((LAMBDA (G0036) (SETQ UNITS G0036) (GO LOOP))
	       (CDR UNITS))))
      UNITS))))


(DEFINEQ
  (BROWSE (LAMBDA NIL 
	    (SEED)
	    (INVESTIGATE
	     (RANDOMIZE
	      (INIT 100
		    10
		    4
		    (QUOTE ((A A A B B B B A A A A A B B A A A)
			    (A A B B B B A A (A A) (B B))
			    (A A A B (B A) B A B A)))))
	     (QUOTE ((*A ?B *B ?B A *A A *B *A)
		     (*A *B *B *A (*A) (*B))
		     (? ? * (B A) * ? ?)))))))

(TIMER TIMIT
       (BROWSE))